home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / PROGRAMR / MWCC03.ZIP / RTL.ZIP / MMSGBOX.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-18  |  15KB  |  511 lines
  1. {**********************************************************************}
  2. {*                                                                    *}
  3. {*          Microworks Custom Control Object Library                            *}
  4. {*                                                                    *}
  5. {*         Version 1.03                                                     *}
  6. {*                                                                    *}
  7. {*     Object Windows Library Extension for Borland Pascal v7.0       *}
  8. {*                                                                    *}
  9. {*     and Turbo Pascal for Windows v 1.5                             *}
  10. {*                                                                    *}
  11. {*         MMsgBox : Message Box Unit                                         *}
  12. {*                                                                    *}
  13. {*     Copyright 1992-93 Microworks (Jeff Franks) Sydney, Australia.  *}
  14. {*                                                                    *}
  15. {**********************************************************************}
  16.  
  17. unit MMsgBox;
  18.  
  19. interface
  20.  
  21. uses WinProcs, WinTypes;
  22.  
  23. type
  24.  
  25.     TMinMaxInfo = array [0..4] of TPoint;
  26.     PMinMaxInfo = ^TMinMaxInfo;
  27.  
  28.     function  MWCCMsgBox (WndParent: HWnd; ATxt, ACaption: PChar; ATextType: Word;
  29.                                                 ABmp: PChar): Integer;
  30.  
  31.     function  SFXMsgBox (WndParent: HWnd; ATxt, ACaption: PChar; ATextType: Word): Integer;
  32.  
  33.     function  CreateDefaultFont (IsBold: Boolean): HFont;
  34.  
  35.     procedure Draw3DBorder (Wnd: HWnd; X, Y, W, H: Integer; Shade: Word);
  36.  
  37.     procedure DrawSFXFrame (Wnd: HWnd);
  38.  
  39.     procedure DrawMsgBoxButton (Wnd: HWnd; lParam: LongInt);
  40.  
  41.     procedure MsgBoxKeyDown (ParentWnd, Wnd: HWnd; wParam: Word);
  42.  
  43.     procedure PaintMsgBox (Wnd: HWnd; AText: PChar; Ofs1, Ofs2, Ofs3: Integer;
  44.                                                  MsgBmp: HBitmap; SFXStyle: Boolean);
  45.  
  46. implementation
  47.  
  48. const
  49.  
  50.     ctl_Recessed = 51;
  51.  
  52. var
  53.  
  54.     Default1    : Boolean;
  55.     Default2    : Boolean;
  56.     Default3    : Boolean;
  57.     SFXStyle    : Boolean;
  58.     BkBmp       : HBitmap;
  59.     MsgBmp      : HBitmap;
  60.     UpBmp1      : HBitmap;
  61.     UpBmp2      : HBitmap;
  62.     UpBmp3      : HBitmap;
  63.     BkBrush     : HBrush;
  64.     LastWnd     : HWnd;
  65.     MsgBoxWnd   : HWnd;
  66.     WndButton1  : HWnd;
  67.     WndButton2  : HWnd;
  68.     WndButton3  : HWnd;
  69.     ID1         : Integer;
  70.     ID2         : Integer;
  71.     ID3         : Integer;
  72.     a           : Integer;
  73.     b           : Integer;
  74.     c           : Integer;
  75.     d           : Integer;
  76.     e           : Integer;
  77.     f           : Integer;
  78.     Reply       : Integer;
  79.     ButtonProc1 : TFarProc;
  80.     ButtonProc2 : TFarProc;
  81.     ButtonProc3 : TFarProc;
  82.     OldProc1    : TFarProc;
  83.     OldProc2    : TFarProc;
  84.     OldProc3    : TFarProc;
  85.     HLib        : THandle;
  86.     MWCCWndHdl  : THandle;
  87.     SFXWndHdl   : THandle;
  88.     WinRect     : TRect;
  89.     TextType    : Word;
  90.     szText      : array[0..255] of Char;
  91.     szTitle     : array[0..50] of Char;
  92.  
  93. {********** External functions and procedures **********}
  94.  
  95. function  CreateDefaultFont; external 'MWCC' Index 1;
  96.  
  97. procedure Draw3DBorder; external 'MWCC' Index 5;
  98.  
  99. procedure DrawSFXFrame; external 'MWCC' Index 10;
  100.  
  101. procedure DrawMsgBoxButton; external 'MWCC' Index 11;
  102.  
  103. procedure MsgBoxKeyDown; external 'MWCC' Index 12;
  104.  
  105. procedure PaintMsgBox; external 'MWCC' Index 13;
  106.  
  107. {********** MWCCMsgBox and SFXMsgBox **********}
  108.  
  109. procedure InitializeData;
  110. begin
  111.     Default1    := False;
  112.     Default2    := False;
  113.     Default3    := False;
  114.     SFXStyle    := False;
  115.     BkBmp       := 0;
  116.     MsgBmp      := 0;
  117.     UpBmp1      := 0;
  118.     UpBmp2      := 0;
  119.     UpBmp3      := 0;
  120.     BkBrush     := 0;
  121.     LastWnd     := 0;
  122.     MsgBoxWnd   := 0;
  123.     WndButton1  := 0;
  124.     WndButton2  := 0;
  125.     WndButton3  := 0;
  126.     ID1         := 0;
  127.     ID2         := 0;
  128.     ID3         := 0;
  129.     a           := 0;
  130.     b           := 0;
  131.     c           := 0;
  132.     d           := 0;
  133.     e           := 0;
  134.     f           := 0;
  135.     ButtonProc1 := nil;
  136.     ButtonProc2 := nil;
  137.     ButtonProc3 := nil;
  138.     OldProc1    := nil;
  139.     OldProc2    := nil;
  140.     OldProc3    := nil;
  141.     HLib        := 0;
  142.     MWCCWndHdl  := 0;
  143.     SFXWndHdl   := 0;
  144. end;
  145.  
  146. function MsgBoxButton1Proc (Wnd: HWnd; Message, wParam: Word; lParam: Longint): Longint; export;
  147. begin
  148.     MsgBoxButton1Proc := 0;
  149.     case Message of
  150.         wm_KeyDown : MsgboxKeyDown(MsgBoxWnd, Wnd, wParam);
  151.     end;
  152.     MsgBoxButton1Proc :=    CallWindowProc (OldProc1, Wnd, Message, wParam, lParam);
  153. end;
  154.  
  155. function MsgBoxButton2Proc (Wnd: HWnd; Message, wParam: Word; lParam: Longint): Longint; export;
  156. begin
  157.     MsgBoxButton2Proc := 0;
  158.     case Message of
  159.         wm_KeyDown : MsgboxKeyDown(MsgBoxWnd, Wnd, wParam);
  160.     end;
  161.     MsgBoxButton2Proc :=    CallWindowProc (OldProc2, Wnd, Message, wParam, lParam);
  162. end;
  163.  
  164. function MsgBoxButton3Proc (Wnd: HWnd; Message, wParam: Word; lParam: Longint): Longint; export;
  165. begin
  166.     MsgBoxButton3Proc := 0;
  167.     case Message of
  168.         wm_KeyDown : MsgboxKeyDown(MsgBoxWnd, Wnd, wParam);
  169.     end;
  170.     MsgBoxButton3Proc :=    CallWindowProc (OldProc3, Wnd, Message, wParam, lParam);
  171. end;
  172.  
  173. function MsgBoxProc(Wnd: HWnd; Message, wParam: Word; lParam: Longint): Longint; export;
  174. type
  175.     NCRect = array[0..2] of TRect;
  176.     PRect  = ^NCRect;
  177. var
  178.     MinMaxInfo : PMinMaxInfo;
  179. begin
  180.     MsgBoxProc := 0;
  181.     case Message of
  182.         wm_Destroy:
  183.         begin
  184.             if HLib >= 32 then FreeLibrary(HLib);
  185.             if BkBmp <> 0 then
  186.             begin
  187.                 DeleteObject(BkBmp);
  188.                 DeleteObject(BkBrush);
  189.             end;
  190.             if MsgBmp <> 0 then DeleteObject(MsgBmp);
  191.             if UpBmp1 <> 0 then DeleteObject(UpBmp1);
  192.             if UpBmp2 <> 0 then DeleteObject(UpBmp2);
  193.             if UpBmp3 <> 0 then DeleteObject(UpBmp3);
  194.             PostQuitMessage(0);
  195.             Exit;
  196.         end;
  197.         wm_Paint:
  198.         begin
  199.             PaintMsgBox (Wnd, szText, a, e, f, MsgBmp, SFXStyle);
  200.             if SFXStyle then DrawSFXFrame(Wnd);
  201.         end;
  202.         wm_DrawItem: DrawMsgBoxButton(Wnd, lParam);
  203.         wm_Command:
  204.         begin
  205.             if HiWord(lParam) = bn_Clicked then
  206.             begin
  207.                 Reply := wParam;
  208.                 EnableWindow(LastWnd, True);
  209.                 SetFocus(LastWnd);
  210.                 DestroyWindow(Wnd);
  211.                 if SFXStyle  then
  212.                     UnregisterClass('SFXMsgBoxWindow', SFXWndHdl)
  213.                 else
  214.                     UnregisterClass('MWCCMsgBoxWindow', MWCCWndHdl);
  215.             end;
  216.         end;
  217.         wm_NCPaint:
  218.         begin
  219.             if SFXStyle then
  220.             begin
  221.                 DrawSFXFrame(Wnd);
  222.                 GetWindowText(Wnd, szTitle, sizeof(szTitle));
  223.                 SetWindowText(Wnd, szTitle);
  224.                 MsgBoxProc := 1;
  225.                 Exit;
  226.             end;
  227.         end;
  228.         wm_NCCalcSize: if SFXStyle then Inc(PRect(lParam)^[0].Top, 1);
  229.         wm_Activate: if SFXStyle then DrawSFXFrame(Wnd);
  230.         wm_NCActivate: if SFXStyle then DrawSFXFrame(Wnd);
  231.         wm_ActivateApp: if SFXStyle then DrawSFXFrame(Wnd);
  232.         wm_GetMinMaxInfo:
  233.         begin
  234.             longInt(MinMaxInfo) := lParam;
  235.             GetWindowRect(Wnd, WinRect);
  236.             if ((WinRect.Right-WinRect.Left) > 36) and ((WinRect.Bottom-WinRect.Top) > 36) then
  237.             begin
  238.                 MinMaxInfo^[1].X :=  WinRect.Right - WinRect.Left;
  239.                 MinMaxInfo^[1].Y :=  WinRect.Bottom - WinRect.Top;
  240.                 MinMaxInfo^[3].X :=  WinRect.Right - WinRect.Left;
  241.                 MinMaxInfo^[3].Y :=  WinRect.Bottom - WinRect.Top;
  242.                 MinMaxInfo^[4].X :=  WinRect.Right - WinRect.Left;
  243.                 MinMaxInfo^[4].Y :=  WinRect.Bottom - WinRect.Top;
  244.             end;
  245.         end;
  246.     end;
  247.     MsgBoxProc := DefWindowProc(Wnd, Message, wParam, lParam);
  248. end;
  249.  
  250. procedure MsgBoxWinMain (WndParent: HWnd; ATxt, ACaption: PChar; ATextType: Word; ABmp: PChar);
  251. label
  252.     CaseExit;
  253. const
  254.     MWCCWndClass : TWndClass = (style         : 0;
  255.                                                             lpfnWndProc   : @MsgBoxProc;
  256.                                                             cbClsExtra    : 0;
  257.                                                             cbWndExtra    : 0;
  258.                                                             hInstance     : 0;
  259.                                                             hIcon         : 0;
  260.                                                             hCursor       : 0;
  261.                                                             hbrBackground : 0;
  262.                                                             lpszMenuName  : nil;
  263.                                                             lpszClassName : 'MWCCMsgBoxWindow');
  264.  
  265.     SFXWndClass : TWndClass = (style         : 0;
  266.                                                          lpfnWndProc   : @MsgBoxProc;
  267.                                                          cbClsExtra    : 0;
  268.                                                          cbWndExtra    : 0;
  269.                                                          hInstance     : 0;
  270.                                                          hIcon         : 0;
  271.                                                          hCursor       : 0;
  272.                                                          hbrBackground : 0;
  273.                                                          lpszMenuName  : nil;
  274.                                                          lpszClassName : 'SFXMsgBoxWindow');
  275. var
  276.     SysMenu  : HMenu;
  277.     FocusWnd : HWnd;
  278.     W        : Integer;
  279.     H        : Integer;
  280.     XScreen  : Integer;
  281.     YScreen  : I